home *** CD-ROM | disk | FTP | other *** search
/ Aminet 24 / Aminet 24 (1998)(GTI - Schatztruhe)[!][Apr 1998].iso / Aminet / dev / c / AmiVoGL_MDEV.lha / examples / fcurves.for < prev    next >
Text File  |  1991-06-07  |  5KB  |  263 lines
  1. c
  2. c using curves
  3. c
  4.     program fcurve
  5.  
  6. $INCLUDE: 'fvogl.h'
  7. $INCLUDE: 'fvodevic.h'
  8.  
  9.     character buf*50
  10.     real bezier(4, 4), cardin(4, 4), bsplin(4, 4)
  11.     real geom1(3, 4), geom2(3, 6)
  12.     integer *2 val
  13. c
  14. c curve basis types
  15. c
  16.     data bezier /
  17.      +      -1.0,    3.0,    -3.0,    1.0,
  18.      +      3.0,    -6.0,    3.0,    0.0,
  19.      +      -3.0,    3.0,    0.0,    0.0,
  20.      +      1.0,    0.0,    0.0,    0.0 
  21.      +  /
  22.  
  23.     data cardin /
  24.      +      -0.5,    1.5,    -1.5,    0.5,
  25.      +      1.0,    -2.5,    2.0,    -0.5,
  26.      +      -0.5,    0.0,    0.5,    0.0,
  27.      +      0.0,    1.0,    0.0,    0.0
  28.      +  /
  29.  
  30.     data bsplin /
  31.      +          -0.166666,     0.5,     -0.5,     0.166666,
  32.      +           0.5,         -1.0,      0.5,     0.0,
  33.      +          -0.5,          0.0,      0.5,     0.0,
  34.      +           0.166666,     0.666666, 0.166666, 0.0
  35.      +  /
  36.  
  37. c
  38. c Geometry matrix to demonstrate basic spline segments
  39. c
  40.     data geom1 /
  41.      +       -180.0, 10.0, 0.0,
  42.      +       -100.0, 110.0, 0.0,
  43.      +       -100.0, -90.0, 0.0,
  44.      +       0.0, 50.0, 0.0
  45.      +  /
  46.  
  47. c
  48. c Geometry matrix to demonstrate overlapping control points to
  49. c produce continuous (Well, except for the bezier ones) curves
  50. c from spline segments
  51. c
  52.     data geom2 /
  53.      +      200.0, 480.0, 0.0,
  54.      +      380.0, 180.0, 0.0,
  55.      +      250.0, 430.0, 0.0,
  56.      +      100.0, 130.0, 0.0,
  57.      +      50.0,  280.0, 0.0,
  58.      +      150.0, 380.0, 0.0
  59.      +  /
  60.  
  61.  
  62.     call winope('fcurves', 7)
  63. c
  64. c We'll use the SPACE bar to go to the next curve...
  65. c
  66.     call unqdev(INPUTC)
  67.     call qdevic(SPACEK)
  68.  
  69.     call ortho2(-200.0, 400.0, -100.0, 500.0)
  70.  
  71.     call color(BLACK)
  72.     call clear()
  73.  
  74.     call color(YELLOW)
  75.  
  76. c
  77. c label the control points in geom1
  78. c
  79.     do 10 i = 1, 4
  80.         call cmov2(geom1(1, i), geom1(2, i))
  81.         write(buf, '(i1)')i
  82.         call charst(buf, nchars(buf))
  83. 10    continue
  84.                                  
  85. c
  86. c label the control points in geom2
  87. c
  88.     do 20 i = 1, 6
  89.         call cmov2(geom2(1, i), geom2(2, i))
  90.         write(buf, '(i1)')i
  91.         call charst(buf, nchars(buf))
  92. 20    continue
  93.  
  94. c
  95. c set the number of line segments appearing in each curve to 20
  96. c
  97.     call curvep(20)
  98.  
  99. c
  100. c define the basis matricies
  101. c
  102.     call defbas(1, bezier)
  103.     call defbas(2, cardin)
  104.     call defbas(3, bsplin)
  105.  
  106. c
  107. c set the current basis as a bezier basis
  108. c
  109.     call curveb(1)
  110.  
  111.     call color(RED)
  112.  
  113. c
  114. c draw a curve using the current basis matrix (bezier in this case)
  115. c and the control points in geom1
  116. c
  117.     call crv(geom1)
  118.  
  119.     call cmov2(70.0, 60.0)
  120.     call charst('Bezier Curve Segment', 20)
  121.  
  122.     call cmov2(-190.0, 450.0)
  123.     call charst('Three overlapping Bezier Curves', 31)
  124.  
  125. c
  126. c curven draws overlapping curve segments according to geom2, the
  127. c number of curve segments drawn is three less than the number of
  128. c points passed, assuming there are a least four points in the
  129. c geometry matrix (in this case geom2). This call will draw 3
  130. c overlapping curve segments in the current basis matrix - still
  131. c bezier.
  132. c
  133.     call crvn(6, geom2)
  134.  
  135.     idum = qread(val)
  136. c
  137. c    Eat the up event as well...
  138. c
  139.     idum = qread(val)
  140.  
  141. c
  142. c load in the cardinal basis matrix
  143. c
  144.     call curveb(2)
  145.  
  146.     call color(MAGENT)
  147.  
  148.     call cmov2(70.0, 10.0)
  149.     call charst('Cardinal Curve Segment', 22)
  150.  
  151. c
  152. c plot out a curve segment using the cardinal basis matrix
  153. c
  154.     call crv(geom1)
  155.  
  156.     call cmov2(-190.0, 400.0)
  157.     call charst('Three overlapping Cardinal Curves', 33)
  158.  
  159. c
  160. c now draw a bunch of them again.
  161. c
  162.     call crvn(6, geom2)
  163.  
  164.     idum = qread(val)
  165. c
  166. c    Eat the up event as well...
  167. c
  168.     idum = qread(val)
  169.  
  170. c
  171. c change the basis matrix again
  172. c
  173.     call curveb(3)
  174.  
  175.     call color(GREEN)
  176.  
  177.     call cmov2(70.0, -40.0)
  178.     call charst('Bspline Curve Segment', 21)
  179.  
  180. c
  181. c now draw our curve segment in the new basis...
  182. c
  183.     call crv(geom1)
  184.  
  185.     call cmov2(-190.0, 350.0)
  186.     call charst('Three overlapping Bspline Curves', 32)
  187.  
  188. c
  189. c ...and do some overlapping ones
  190. c
  191.     call crvn(6, geom2)
  192.  
  193.     idum = qread(val)
  194. c
  195. c    Eat the up event as well...
  196. c
  197.     idum = qread(val)
  198.  
  199.     call gexit
  200.  
  201.     end
  202. c
  203. c nchars
  204. c
  205. c return the real length of a string padded with blanks
  206. c
  207.     integer function nchars(str)
  208.     character *(*) str
  209.  
  210.     do 10 i = len(str), 1, -1
  211.         if (str(i:i) .ne. ' ') then
  212.             nchars = i
  213.             return
  214.         end if
  215. 10      continue
  216.  
  217.     nchars = 0
  218.  
  219.     return
  220.  
  221.     end
  222. c
  223. c ShowCi
  224. c
  225. c    show a ring of text
  226. c
  227.     subroutine ShowCi(r, str)
  228.     real r
  229.     character*(*) str
  230.  
  231.     real i, inc, x, y, a, pi
  232.     integer j
  233.     character*1 c
  234.     parameter (pi = 3.1415926535)
  235.  
  236.     j = 1
  237.     inc = 360.0 / nchars(str)
  238.  
  239.     do 10 i = 0, 360.0, inc
  240. c
  241. c calculate the next drawing position
  242. c
  243.         c = str(j:j)
  244.         x = r * cos(i * pi / 180.0)
  245.         y = r * sin(i * pi / 180.0)
  246.         call move2(x, y)
  247. c
  248. c calculate angle for next character
  249. c
  250.         a = 90.0 + i
  251. c
  252. c set the orientation of the next character
  253. c
  254.         call htexta(a)
  255. c
  256. c draw the character
  257. c
  258.         call hdrawc(c)
  259.         j = j + 1
  260. 10    continue
  261.  
  262.     end
  263.